home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / mg.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  23KB  |  1,251 lines
  1. /*    mg.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Sam sat on the ground and put his head in his hands.  'I wish I had never
  12.  * come here, and I don't want to see no more magic,' he said, and fell silent."
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /* Omit -- it causes too much grief on mixed systems.
  19. #ifdef I_UNISTD
  20. # include <unistd.h>
  21. #endif
  22. */
  23.  
  24. void
  25. mg_magical(sv)
  26. SV* sv;
  27. {
  28.     MAGIC* mg;
  29.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  30.     MGVTBL* vtbl = mg->mg_virtual;
  31.     if (vtbl) {
  32.         if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
  33.         SvGMAGICAL_on(sv);
  34.         if (vtbl->svt_set)
  35.         SvSMAGICAL_on(sv);
  36.         if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  37.         SvRMAGICAL_on(sv);
  38.     }
  39.     }
  40. }
  41.  
  42. int
  43. mg_get(sv)
  44. SV* sv;
  45. {
  46.     MAGIC* mg;
  47.     U32 savemagic = SvMAGICAL(sv) | SvREADONLY(sv);
  48.  
  49.     assert(SvGMAGICAL(sv));
  50.     SvMAGICAL_off(sv);
  51.     SvREADONLY_off(sv);
  52.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  53.  
  54.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  55.     MGVTBL* vtbl = mg->mg_virtual;
  56.     if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
  57.         (*vtbl->svt_get)(sv, mg);
  58.         if (mg->mg_flags & MGf_GSKIP)
  59.         savemagic = 0;
  60.     }
  61.     }
  62.  
  63.     if (savemagic)
  64.     SvFLAGS(sv) |= savemagic;
  65.     else
  66.     mg_magical(sv);
  67.     if (SvGMAGICAL(sv))
  68.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  69.  
  70.     return 0;
  71. }
  72.  
  73. int
  74. mg_set(sv)
  75. SV* sv;
  76. {
  77.     MAGIC* mg;
  78.     MAGIC* nextmg;
  79.     U32 savemagic = SvMAGICAL(sv);
  80.  
  81.     SvMAGICAL_off(sv);
  82.  
  83.     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  84.     MGVTBL* vtbl = mg->mg_virtual;
  85.     nextmg = mg->mg_moremagic;    /* it may delete itself */
  86.     if (mg->mg_flags & MGf_GSKIP) {
  87.         mg->mg_flags &= ~MGf_GSKIP;    /* setting requires another read */
  88.         savemagic = 0;
  89.     }
  90.     if (vtbl && vtbl->svt_set)
  91.         (*vtbl->svt_set)(sv, mg);
  92.     }
  93.  
  94.     if (SvMAGIC(sv)) {
  95.     if (savemagic)
  96.         SvFLAGS(sv) |= savemagic;
  97.     else
  98.         mg_magical(sv);
  99.     if (SvGMAGICAL(sv))
  100.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  101.     }
  102.  
  103.     return 0;
  104. }
  105.  
  106. U32
  107. mg_len(sv)
  108. SV* sv;
  109. {
  110.     MAGIC* mg;
  111.     char *s;
  112.     STRLEN len;
  113.  
  114.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  115.     MGVTBL* vtbl = mg->mg_virtual;
  116.     if (vtbl && vtbl->svt_len) {
  117.         U32 savemagic = SvMAGICAL(sv);
  118.  
  119.         SvMAGICAL_off(sv);
  120.         SvFLAGS(sv) |= (SvFLAGS(sv)&(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  121.  
  122.         /* omit MGf_GSKIP -- not changed here */
  123.         len = (*vtbl->svt_len)(sv, mg);
  124.  
  125.         SvFLAGS(sv) |= savemagic;
  126.         if (SvGMAGICAL(sv))
  127.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  128.  
  129.         return len;
  130.     }
  131.     }
  132.  
  133.     s = SvPV(sv, len);
  134.     return len;
  135. }
  136.  
  137. int
  138. mg_clear(sv)
  139. SV* sv;
  140. {
  141.     MAGIC* mg;
  142.     U32 savemagic = SvMAGICAL(sv);
  143.  
  144.     SvMAGICAL_off(sv);
  145.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  146.  
  147.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  148.     MGVTBL* vtbl = mg->mg_virtual;
  149.     /* omit GSKIP -- never set here */
  150.     
  151.     if (vtbl && vtbl->svt_clear)
  152.         (*vtbl->svt_clear)(sv, mg);
  153.     }
  154.  
  155.     SvFLAGS(sv) |= savemagic;
  156.     if (SvGMAGICAL(sv))
  157.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  158.  
  159.     return 0;
  160. }
  161.  
  162. MAGIC*
  163. mg_find(sv, type)
  164. SV* sv;
  165. int type;
  166. {
  167.     MAGIC* mg;
  168.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  169.     if (mg->mg_type == type)
  170.         return mg;
  171.     }
  172.     return 0;
  173. }
  174.  
  175. int
  176. mg_copy(sv, nsv, key, klen)
  177. SV* sv;
  178. SV* nsv;
  179. char *key;
  180. STRLEN klen;
  181. {
  182.     int count = 0;
  183.     MAGIC* mg;
  184.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  185.     if (isUPPER(mg->mg_type)) {
  186.         sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
  187.         count++;
  188.     }
  189.     }
  190.     return count;
  191. }
  192.  
  193. int
  194. mg_free(sv)
  195. SV* sv;
  196. {
  197.     MAGIC* mg;
  198.     MAGIC* moremagic;
  199.     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
  200.     MGVTBL* vtbl = mg->mg_virtual;
  201.     moremagic = mg->mg_moremagic;
  202.     if (vtbl && vtbl->svt_free)
  203.         (*vtbl->svt_free)(sv, mg);
  204.     if (mg->mg_ptr && mg->mg_type != 'g')
  205.         Safefree(mg->mg_ptr);
  206.     if (mg->mg_flags & MGf_REFCOUNTED)
  207.         SvREFCNT_dec(mg->mg_obj);
  208.     Safefree(mg);
  209.     }
  210.     SvMAGIC(sv) = 0;
  211.     return 0;
  212. }
  213.  
  214. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  215. #include <signal.h>
  216. #endif
  217.  
  218. U32
  219. magic_len(sv, mg)
  220. SV *sv;
  221. MAGIC *mg;
  222. {
  223.     register I32 paren;
  224.     register char *s;
  225.     register I32 i;
  226.  
  227.     switch (*mg->mg_ptr) {
  228.     case '1': case '2': case '3': case '4':
  229.     case '5': case '6': case '7': case '8': case '9': case '&':
  230.     if (curpm) {
  231.         paren = atoi(mg->mg_ptr);
  232.       getparen:
  233.         if (curpm->op_pmregexp &&
  234.           paren <= curpm->op_pmregexp->nparens &&
  235.           (s = curpm->op_pmregexp->startp[paren]) ) {
  236.         i = curpm->op_pmregexp->endp[paren] - s;
  237.         if (i >= 0)
  238.             return i;
  239.         else
  240.             return 0;
  241.         }
  242.         else
  243.         return 0;
  244.     }
  245.     break;
  246.     case '+':
  247.     if (curpm) {
  248.         paren = curpm->op_pmregexp->lastparen;
  249.         if (!paren)
  250.         return 0;
  251.         goto getparen;
  252.     }
  253.     break;
  254.     case '`':
  255.     if (curpm) {
  256.         if (curpm->op_pmregexp &&
  257.           (s = curpm->op_pmregexp->subbeg) ) {
  258.         i = curpm->op_pmregexp->startp[0] - s;
  259.         if (i >= 0)
  260.             return i;
  261.         else
  262.             return 0;
  263.         }
  264.         else
  265.         return 0;
  266.     }
  267.     break;
  268.     case '\'':
  269.     if (curpm) {
  270.         if (curpm->op_pmregexp &&
  271.           (s = curpm->op_pmregexp->endp[0]) ) {
  272.         return (STRLEN) (curpm->op_pmregexp->subend - s);
  273.         }
  274.         else
  275.         return 0;
  276.     }
  277.     break;
  278.     case ',':
  279.     return (STRLEN)ofslen;
  280.     case '\\':
  281.     return (STRLEN)orslen;
  282.     }
  283.     magic_get(sv,mg);
  284.     if (!SvPOK(sv) && SvNIOK(sv))
  285.     sv_2pv(sv, &na);
  286.     if (SvPOK(sv))
  287.     return SvCUR(sv);
  288.     return 0;
  289. }
  290.  
  291. int
  292. magic_get(sv, mg)
  293. SV *sv;
  294. MAGIC *mg;
  295. {
  296.     register I32 paren;
  297.     register char *s;
  298.     register I32 i;
  299.  
  300.     switch (*mg->mg_ptr) {
  301.     case '\004':        /* ^D */
  302.     sv_setiv(sv,(I32)(debug & 32767));
  303.     break;
  304.     case '\006':        /* ^F */
  305.     sv_setiv(sv,(I32)maxsysfd);
  306.     break;
  307.     case '\010':        /* ^H */
  308.     sv_setiv(sv,(I32)hints);
  309.     break;
  310.     case '\t':            /* ^I */
  311.     if (inplace)
  312.         sv_setpv(sv, inplace);
  313.     else
  314.         sv_setsv(sv,&sv_undef);
  315.     break;
  316.     case '\020':        /* ^P */
  317.     sv_setiv(sv,(I32)perldb);
  318.     break;
  319.     case '\024':        /* ^T */
  320.     sv_setiv(sv,(I32)basetime);
  321.     break;
  322.     case '\027':        /* ^W */
  323.     sv_setiv(sv,(I32)dowarn);
  324.     break;
  325.     case '1': case '2': case '3': case '4':
  326.     case '5': case '6': case '7': case '8': case '9': case '&':
  327.     if (curpm) {
  328.         paren = atoi(GvENAME(mg->mg_obj));
  329.       getparen:
  330.         if (curpm->op_pmregexp &&
  331.           paren <= curpm->op_pmregexp->nparens &&
  332.           (s = curpm->op_pmregexp->startp[paren]) &&
  333.           curpm->op_pmregexp->endp[paren] ) {
  334.         i = curpm->op_pmregexp->endp[paren] - s;
  335.         if (i >= 0)
  336.             sv_setpvn(sv,s,i);
  337.         else
  338.             sv_setsv(sv,&sv_undef);
  339.         }
  340.         else
  341.         sv_setsv(sv,&sv_undef);
  342.     }
  343.     break;
  344.     case '+':
  345.     if (curpm) {
  346.         paren = curpm->op_pmregexp->lastparen;
  347.         if (paren)
  348.         goto getparen;
  349.         else
  350.         sv_setsv(sv,&sv_undef);
  351.     }
  352.     break;
  353.     case '`':
  354.     if (curpm) {
  355.         if (curpm->op_pmregexp &&
  356.           (s = curpm->op_pmregexp->subbeg) ) {
  357.         i = curpm->op_pmregexp->startp[0] - s;
  358.         if (i >= 0)
  359.             sv_setpvn(sv,s,i);
  360.         else
  361.             sv_setpvn(sv,"",0);
  362.         }
  363.         else
  364.         sv_setpvn(sv,"",0);
  365.     }
  366.     break;
  367.     case '\'':
  368.     if (curpm) {
  369.         if (curpm->op_pmregexp &&
  370.           (s = curpm->op_pmregexp->endp[0]) ) {
  371.         sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
  372.         }
  373.         else
  374.         sv_setpvn(sv,"",0);
  375.     }
  376.     break;
  377.     case '.':
  378. #ifndef lint
  379.     if (GvIO(last_in_gv)) {
  380.         sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
  381.     }
  382. #endif
  383.     break;
  384.     case '?':
  385.     sv_setiv(sv,(I32)statusvalue);
  386.     break;
  387.     case '^':
  388.     s = IoTOP_NAME(GvIOp(defoutgv));
  389.     if (s)
  390.         sv_setpv(sv,s);
  391.     else {
  392.         sv_setpv(sv,GvENAME(defoutgv));
  393.         sv_catpv(sv,"_TOP");
  394.     }
  395.     break;
  396.     case '~':
  397.     s = IoFMT_NAME(GvIOp(defoutgv));
  398.     if (!s)
  399.         s = GvENAME(defoutgv);
  400.     sv_setpv(sv,s);
  401.     break;
  402. #ifndef lint
  403.     case '=':
  404.     sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
  405.     break;
  406.     case '-':
  407.     sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
  408.     break;
  409.     case '%':
  410.     sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
  411.     break;
  412. #endif
  413.     case ':':
  414.     break;
  415.     case '/':
  416.     break;
  417.     case '[':
  418.     sv_setiv(sv,(I32)curcop->cop_arybase);
  419.     break;
  420.     case '|':
  421.     sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
  422.     break;
  423.     case ',':
  424.     sv_setpvn(sv,ofs,ofslen);
  425.     break;
  426.     case '\\':
  427.     sv_setpvn(sv,ors,orslen);
  428.     break;
  429.     case '#':
  430.     sv_setpv(sv,ofmt);
  431.     break;
  432.     case '!':
  433.     sv_setnv(sv,(double)errno);
  434.     sv_setpv(sv, errno ? Strerror(errno) : "");
  435.     SvNOK_on(sv);    /* what a wonderful hack! */
  436.     break;
  437.     case '<':
  438.     sv_setiv(sv,(I32)uid);
  439.     break;
  440.     case '>':
  441.     sv_setiv(sv,(I32)euid);
  442.     break;
  443.     case '(':
  444.     s = buf;
  445.     (void)sprintf(s,"%d",(int)gid);
  446.     goto add_groups;
  447.     case ')':
  448.     s = buf;
  449.     (void)sprintf(s,"%d",(int)egid);
  450.       add_groups:
  451.     while (*s) s++;
  452. #ifdef HAS_GETGROUPS
  453. #ifndef NGROUPS
  454. #define NGROUPS 32
  455. #endif
  456.     {
  457.         Groups_t gary[NGROUPS];
  458.  
  459.         i = getgroups(NGROUPS,gary);
  460.         while (--i >= 0) {
  461.         (void)sprintf(s," %ld", (long)gary[i]);
  462.         while (*s) s++;
  463.         }
  464.     }
  465. #endif
  466.     sv_setpv(sv,buf);
  467.     break;
  468.     case '*':
  469.     break;
  470.     case '0':
  471.     break;
  472.     }
  473.     return 0;
  474. }
  475.  
  476. int
  477. magic_getuvar(sv, mg)
  478. SV *sv;
  479. MAGIC *mg;
  480. {
  481.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  482.  
  483.     if (uf && uf->uf_val)
  484.     (*uf->uf_val)(uf->uf_index, sv);
  485.     return 0;
  486. }
  487.  
  488. int
  489. magic_setenv(sv,mg)
  490. SV* sv;
  491. MAGIC* mg;
  492. {
  493.     register char *s;
  494.     STRLEN len;
  495.     I32 i;
  496.     s = SvPV(sv,len);
  497.     my_setenv(mg->mg_ptr,s);
  498. #ifdef DYNAMIC_ENV_FETCH
  499.      /* We just undefd an environment var.  Is a replacement */
  500.      /* waiting in the wings? */
  501.     if (!len) {
  502.     SV **envsvp;
  503.     if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
  504.         s = SvPV(*envsvp,len);
  505.     }
  506. #endif
  507.                 /* And you'll never guess what the dog had */
  508.                 /*   in its mouth... */
  509.     if (tainting) {
  510.     if (s && strEQ(mg->mg_ptr,"PATH")) {
  511.         char *strend = s + len;
  512.  
  513.         while (s < strend) {
  514.         s = cpytill(tokenbuf,s,strend,':',&i);
  515.         s++;
  516.         if (*tokenbuf != '/'
  517.           || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  518.             MgTAINTEDDIR_on(mg);
  519.         }
  520.     }
  521.     }
  522.     return 0;
  523. }
  524.  
  525. int
  526. magic_clearenv(sv,mg)
  527. SV* sv;
  528. MAGIC* mg;
  529. {
  530.     my_setenv(mg->mg_ptr,Nullch);
  531.     return 0;
  532. }
  533.  
  534. int
  535. magic_setsig(sv,mg)
  536. SV* sv;
  537. MAGIC* mg;
  538. {
  539.     register char *s;
  540.     I32 i;
  541.  
  542.     i = whichsig(mg->mg_ptr);    /* ...no, a brick */
  543.     if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM")))
  544.     warn("No such signal: SIG%s", mg->mg_ptr);
  545.     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
  546.     (void)signal(i,sighandler);
  547.     return 0;
  548.     }
  549.     s = SvPV_force(sv,na);
  550.     if (strEQ(s,"IGNORE"))
  551. #ifndef lint
  552.     (void)signal(i,SIG_IGN);
  553. #else
  554.     ;
  555. #endif
  556.     else if (strEQ(s,"DEFAULT") || !*s)
  557.     (void)signal(i,SIG_DFL);
  558.     else {
  559.     (void)signal(i,sighandler);
  560.     if (!strchr(s,':') && !strchr(s,'\'')) {
  561.         sprintf(tokenbuf, "main::%s",s);
  562.         sv_setpv(sv,tokenbuf);
  563.     }
  564.     }
  565.     return 0;
  566. }
  567.  
  568. int
  569. magic_setisa(sv,mg)
  570. SV* sv;
  571. MAGIC* mg;
  572. {
  573.     sub_generation++;
  574.     return 0;
  575. }
  576.  
  577. #ifdef OVERLOAD
  578.  
  579. int
  580. magic_setamagic(sv,mg)
  581. SV* sv;
  582. MAGIC* mg;
  583. {
  584.     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
  585.     amagic_generation++;
  586.  
  587.     return 0;
  588. }
  589. #endif /* OVERLOAD */
  590.  
  591. static int
  592. magic_methpack(sv,mg,meth)
  593. SV* sv;
  594. MAGIC* mg;
  595. char *meth;
  596. {
  597.     dSP;
  598.  
  599.     ENTER;
  600.     SAVETMPS;
  601.     PUSHMARK(sp);
  602.     EXTEND(sp, 2);
  603.     PUSHs(mg->mg_obj);
  604.     if (mg->mg_ptr)
  605.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  606.     else if (mg->mg_type == 'p')
  607.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  608.     PUTBACK;
  609.  
  610.     if (perl_call_method(meth, G_SCALAR))
  611.     sv_setsv(sv, *stack_sp--);
  612.  
  613.     FREETMPS;
  614.     LEAVE;
  615.     return 0;
  616. }
  617.  
  618. int
  619. magic_getpack(sv,mg)
  620. SV* sv;
  621. MAGIC* mg;
  622. {
  623.     magic_methpack(sv,mg,"FETCH");
  624.     if (mg->mg_ptr)
  625.     mg->mg_flags |= MGf_GSKIP;
  626.     return 0;
  627. }
  628.  
  629. int
  630. magic_setpack(sv,mg)
  631. SV* sv;
  632. MAGIC* mg;
  633. {
  634.     dSP;
  635.  
  636.     PUSHMARK(sp);
  637.     EXTEND(sp, 3);
  638.     PUSHs(mg->mg_obj);
  639.     if (mg->mg_ptr)
  640.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  641.     else if (mg->mg_type == 'p')
  642.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  643.     PUSHs(sv);
  644.     PUTBACK;
  645.  
  646.     perl_call_method("STORE", G_SCALAR|G_DISCARD);
  647.  
  648.     return 0;
  649. }
  650.  
  651. int
  652. magic_clearpack(sv,mg)
  653. SV* sv;
  654. MAGIC* mg;
  655. {
  656.     return magic_methpack(sv,mg,"DELETE");
  657. }
  658.  
  659. int magic_wipepack(sv,mg)
  660. SV* sv;
  661. MAGIC* mg;
  662. {
  663.     dSP;
  664.  
  665.     PUSHMARK(sp);
  666.     XPUSHs(mg->mg_obj);
  667.     PUTBACK;
  668.  
  669.     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
  670.  
  671.     return 0;
  672. }
  673.  
  674. int
  675. magic_nextpack(sv,mg,key)
  676. SV* sv;
  677. MAGIC* mg;
  678. SV* key;
  679. {
  680.     dSP;
  681.     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
  682.  
  683.     ENTER;
  684.     SAVETMPS;
  685.     PUSHMARK(sp);
  686.     EXTEND(sp, 2);
  687.     PUSHs(mg->mg_obj);
  688.     if (SvOK(key))
  689.     PUSHs(key);
  690.     PUTBACK;
  691.  
  692.     if (perl_call_method(meth, G_SCALAR))
  693.     sv_setsv(key, *stack_sp--);
  694.  
  695.     FREETMPS;
  696.     LEAVE;
  697.     return 0;
  698. }
  699.  
  700. int
  701. magic_existspack(sv,mg)
  702. SV* sv;
  703. MAGIC* mg;
  704. {
  705.     return magic_methpack(sv,mg,"EXISTS");
  706. } 
  707.  
  708. int
  709. magic_setdbline(sv,mg)
  710. SV* sv;
  711. MAGIC* mg;
  712. {
  713.     OP *o;
  714.     I32 i;
  715.     GV* gv;
  716.     SV** svp;
  717.  
  718.     gv = DBline;
  719.     i = SvTRUE(sv);
  720.     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
  721.     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
  722.     o->op_private = i;
  723.     else
  724.     warn("Can't break at that line\n");
  725.     return 0;
  726. }
  727.  
  728. int
  729. magic_getarylen(sv,mg)
  730. SV* sv;
  731. MAGIC* mg;
  732. {
  733.     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
  734.     return 0;
  735. }
  736.  
  737. int
  738. magic_setarylen(sv,mg)
  739. SV* sv;
  740. MAGIC* mg;
  741. {
  742.     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
  743.     return 0;
  744. }
  745.  
  746. int
  747. magic_getpos(sv,mg)
  748. SV* sv;
  749. MAGIC* mg;
  750. {
  751.     SV* lsv = LvTARG(sv);
  752.     
  753.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
  754.     mg = mg_find(lsv, 'g');
  755.     if (mg && mg->mg_len >= 0) {
  756.         sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
  757.         return 0;
  758.     }
  759.     }
  760.     (void)SvOK_off(sv);
  761.     return 0;
  762. }
  763.  
  764. int
  765. magic_setpos(sv,mg)
  766. SV* sv;
  767. MAGIC* mg;
  768. {
  769.     SV* lsv = LvTARG(sv);
  770.     SSize_t pos;
  771.     STRLEN len;
  772.  
  773.     mg = 0;
  774.     
  775.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
  776.     mg = mg_find(lsv, 'g');
  777.     if (!mg) {
  778.     if (!SvOK(sv))
  779.         return 0;
  780.     sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
  781.     mg = mg_find(lsv, 'g');
  782.     }
  783.     else if (!SvOK(sv)) {
  784.     mg->mg_len = -1;
  785.     return 0;
  786.     }
  787.     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
  788.  
  789.     pos = SvIV(sv) - curcop->cop_arybase;
  790.     if (pos < 0) {
  791.     pos += len;
  792.     if (pos < 0)
  793.         pos = 0;
  794.     }
  795.     else if (pos > len)
  796.     pos = len;
  797.     mg->mg_len = pos;
  798.  
  799.     return 0;
  800. }
  801.  
  802. int
  803. magic_getglob(sv,mg)
  804. SV* sv;
  805. MAGIC* mg;
  806. {
  807.     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
  808.     return 0;
  809. }
  810.  
  811. int
  812. magic_setglob(sv,mg)
  813. SV* sv;
  814. MAGIC* mg;
  815. {
  816.     register char *s;
  817.     GV* gv;
  818.  
  819.     if (!SvOK(sv))
  820.     return 0;
  821.     s = SvPV(sv, na);
  822.     if (*s == '*' && s[1])
  823.     s++;
  824.     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
  825.     if (sv == (SV*)gv)
  826.     return 0;
  827.     if (GvGP(sv))
  828.     gp_free(sv);
  829.     GvGP(sv) = gp_ref(GvGP(gv));
  830.     if (!GvAV(gv))
  831.     gv_AVadd(gv);
  832.     if (!GvHV(gv))
  833.     gv_HVadd(gv);
  834.     if (!GvIOp(gv))
  835.     GvIOp(gv) = newIO();
  836.     return 0;
  837. }
  838.  
  839. int
  840. magic_setsubstr(sv,mg)
  841. SV* sv;
  842. MAGIC* mg;
  843. {
  844.     STRLEN len;
  845.     char *tmps = SvPV(sv,len);
  846.     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
  847.     return 0;
  848. }
  849.  
  850. int
  851. magic_gettaint(sv,mg)
  852. SV* sv;
  853. MAGIC* mg;
  854. {
  855.     tainted = TRUE;
  856.     return 0;
  857. }
  858.  
  859. int
  860. magic_settaint(sv,mg)
  861. SV* sv;
  862. MAGIC* mg;
  863. {
  864.     if (!tainted) {
  865.     if (!SvMAGICAL(sv))
  866.         SvMAGICAL_on(sv);
  867.     sv_unmagic(sv, 't');
  868.     }
  869.     return 0;
  870. }
  871.  
  872. int
  873. magic_setvec(sv,mg)
  874. SV* sv;
  875. MAGIC* mg;
  876. {
  877.     do_vecset(sv);    /* XXX slurp this routine */
  878.     return 0;
  879. }
  880.  
  881. int
  882. magic_setmglob(sv,mg)
  883. SV* sv;
  884. MAGIC* mg;
  885. {
  886.     mg->mg_len = -1;
  887.     return 0;
  888. }
  889.  
  890. int
  891. magic_setbm(sv,mg)
  892. SV* sv;
  893. MAGIC* mg;
  894. {
  895.     sv_unmagic(sv, 'B');
  896.     SvVALID_off(sv);
  897.     return 0;
  898. }
  899.  
  900. int
  901. magic_setuvar(sv,mg)
  902. SV* sv;
  903. MAGIC* mg;
  904. {
  905.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  906.  
  907.     if (uf && uf->uf_set)
  908.     (*uf->uf_set)(uf->uf_index, sv);
  909.     return 0;
  910. }
  911.  
  912. int
  913. magic_set(sv,mg)
  914. SV* sv;
  915. MAGIC* mg;
  916. {
  917.     register char *s;
  918.     I32 i;
  919.     STRLEN len;
  920.     switch (*mg->mg_ptr) {
  921.     case '\004':    /* ^D */
  922.     debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  923.     DEBUG_x(dump_all());
  924.     break;
  925.     case '\006':    /* ^F */
  926.     maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  927.     break;
  928.     case '\010':    /* ^H */
  929.     hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  930.     break;
  931.     case '\t':    /* ^I */
  932.     if (inplace)
  933.         Safefree(inplace);
  934.     if (SvOK(sv))
  935.         inplace = savepv(SvPV(sv,na));
  936.     else
  937.         inplace = Nullch;
  938.     break;
  939.     case '\020':    /* ^P */
  940.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  941.     if (i != perldb) {
  942.         if (perldb)
  943.         oldlastpm = curpm;
  944.         else
  945.         curpm = oldlastpm;
  946.     }
  947.     perldb = i;
  948.     break;
  949.     case '\024':    /* ^T */
  950.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  951.     break;
  952.     case '\027':    /* ^W */
  953.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  954.     break;
  955.     case '.':
  956.     if (localizing)
  957.         save_sptr((SV**)&last_in_gv);
  958.     else if (SvOK(sv))
  959.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  960.     break;
  961.     case '^':
  962.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  963.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  964.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  965.     break;
  966.     case '~':
  967.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  968.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  969.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  970.     break;
  971.     case '=':
  972.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  973.     break;
  974.     case '-':
  975.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  976.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  977.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  978.     break;
  979.     case '%':
  980.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  981.     break;
  982.     case '|':
  983.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  984.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  985.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  986.     }
  987.     break;
  988.     case '*':
  989.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  990.     multiline = (i != 0);
  991.     break;
  992.     case '/':
  993.     if (SvOK(sv)) {
  994.         nrs = rs = SvPV_force(sv,rslen);
  995.         nrslen = rslen;
  996.         if (rspara = !rslen) {
  997.         nrs = rs = "\n\n";
  998.         nrslen = rslen = 2;
  999.         }
  1000.         nrschar = rschar = rs[rslen - 1];
  1001.     }
  1002.     else {
  1003.         nrschar = rschar = 0777;    /* fake a non-existent char */
  1004.         nrslen = rslen = 1;
  1005.     }
  1006.     break;
  1007.     case '\\':
  1008.     if (ors)
  1009.         Safefree(ors);
  1010.     ors = savepv(SvPV(sv,orslen));
  1011.     break;
  1012.     case ',':
  1013.     if (ofs)
  1014.         Safefree(ofs);
  1015.     ofs = savepv(SvPV(sv, ofslen));
  1016.     break;
  1017.     case '#':
  1018.     if (ofmt)
  1019.         Safefree(ofmt);
  1020.     ofmt = savepv(SvPV(sv,na));
  1021.     break;
  1022.     case '[':
  1023.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1024.     break;
  1025.     case '?':
  1026.     statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1027.     break;
  1028.     case '!':
  1029.     errno = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);        /* will anyone ever use this? */
  1030.     break;
  1031.     case '<':
  1032.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1033.     if (delaymagic) {
  1034.         delaymagic |= DM_RUID;
  1035.         break;                /* don't do magic till later */
  1036.     }
  1037. #ifdef HAS_SETRUID
  1038.     (void)setruid((Uid_t)uid);
  1039. #else
  1040. #ifdef HAS_SETREUID
  1041.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1042. #ifdef HAS_SETRESUID
  1043.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1044. #else
  1045.     if (uid == euid)        /* special case $< = $> */
  1046.         (void)setuid(uid);
  1047.     else {
  1048.         uid = (I32)getuid();
  1049.         croak("setruid() not implemented");
  1050.     }
  1051. #endif
  1052. #endif
  1053. #endif
  1054.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1055.     tainting |= (euid != uid || egid != gid);
  1056.     break;
  1057.     case '>':
  1058.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1059.     if (delaymagic) {
  1060.         delaymagic |= DM_EUID;
  1061.         break;                /* don't do magic till later */
  1062.     }
  1063. #ifdef HAS_SETEUID
  1064.     (void)seteuid((Uid_t)euid);
  1065. #else
  1066. #ifdef HAS_SETREUID
  1067.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1068. #else
  1069. #ifdef HAS_SETRESUID
  1070.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1071. #else
  1072.     if (euid == uid)        /* special case $> = $< */
  1073.         setuid(euid);
  1074.     else {
  1075.         euid = (I32)geteuid();
  1076.         croak("seteuid() not implemented");
  1077.     }
  1078. #endif
  1079. #endif
  1080. #endif
  1081.     euid = (I32)geteuid();
  1082.     tainting |= (euid != uid || egid != gid);
  1083.     break;
  1084.     case '(':
  1085.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1086.     if (delaymagic) {
  1087.         delaymagic |= DM_RGID;
  1088.         break;                /* don't do magic till later */
  1089.     }
  1090. #ifdef HAS_SETRGID
  1091.     (void)setrgid((Gid_t)gid);
  1092. #else
  1093. #ifdef HAS_SETREGID
  1094.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1095. #else
  1096. #ifdef HAS_SETRESGID
  1097.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1098. #else
  1099.     if (gid == egid)            /* special case $( = $) */
  1100.         (void)setgid(gid);
  1101.     else
  1102.         croak("setrgid() not implemented");
  1103. #endif
  1104. #endif
  1105. #endif
  1106.     gid = (I32)getgid();
  1107.     tainting |= (euid != uid || egid != gid);
  1108.     break;
  1109.     case ')':
  1110.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1111.     if (delaymagic) {
  1112.         delaymagic |= DM_EGID;
  1113.         break;                /* don't do magic till later */
  1114.     }
  1115. #ifdef HAS_SETEGID
  1116.     (void)setegid((Gid_t)egid);
  1117. #else
  1118. #ifdef HAS_SETREGID
  1119.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1120. #else
  1121. #ifdef HAS_SETRESGID
  1122.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1123. #else
  1124.     if (egid == gid)            /* special case $) = $( */
  1125.         (void)setgid(egid);
  1126.     else
  1127.         croak("setegid() not implemented");
  1128. #endif
  1129. #endif
  1130. #endif
  1131.     egid = (I32)getegid();
  1132.     tainting |= (euid != uid || egid != gid);
  1133.     break;
  1134.     case ':':
  1135.     chopset = SvPV_force(sv,na);
  1136.     break;
  1137.     case '0':
  1138.     if (!origalen) {
  1139.         s = origargv[0];
  1140.         s += strlen(s);
  1141.         /* See if all the arguments are contiguous in memory */
  1142.         for (i = 1; i < origargc; i++) {
  1143.         if (origargv[i] == s + 1)
  1144.             s += strlen(++s);    /* this one is ok too */
  1145.         }
  1146.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1147.         my_setenv("NoNeSuCh", Nullch);
  1148.                         /* force copy of environment */
  1149.         for (i = 0; origenviron[i]; i++)
  1150.             if (origenviron[i] == s + 1)
  1151.             s += strlen(++s);
  1152.         }
  1153.         origalen = s - origargv[0];
  1154.     }
  1155.     s = SvPV_force(sv,len);
  1156.     i = len;
  1157.     if (i >= origalen) {
  1158.         i = origalen;
  1159.         SvCUR_set(sv, i);
  1160.         *SvEND(sv) = '\0';
  1161.         Copy(s, origargv[0], i, char);
  1162.     }
  1163.     else {
  1164.         Copy(s, origargv[0], i, char);
  1165.         s = origargv[0]+i;
  1166.         *s++ = '\0';
  1167.         while (++i < origalen)
  1168.         *s++ = ' ';
  1169.         s = origargv[0]+i;
  1170.         for (i = 1; i < origargc; i++)
  1171.         origargv[i] = Nullch;
  1172.     }
  1173.     break;
  1174.     }
  1175.     return 0;
  1176. }
  1177.  
  1178. I32
  1179. whichsig(sig)
  1180. char *sig;
  1181. {
  1182.     register char **sigv;
  1183.  
  1184.     for (sigv = sig_name+1; *sigv; sigv++)
  1185.     if (strEQ(sig,*sigv))
  1186.         return sigv - sig_name;
  1187. #ifdef SIGCLD
  1188.     if (strEQ(sig,"CHLD"))
  1189.     return SIGCLD;
  1190. #endif
  1191. #ifdef SIGCHLD
  1192.     if (strEQ(sig,"CLD"))
  1193.     return SIGCHLD;
  1194. #endif
  1195.     return 0;
  1196. }
  1197.  
  1198. VOIDRET
  1199. sighandler(sig)
  1200. int sig;
  1201. {
  1202.     dSP;
  1203.     GV *gv;
  1204.     HV *st;
  1205.     SV *sv;
  1206.     CV *cv;
  1207.     AV *oldstack;
  1208.  
  1209. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1210.     signal(sig, SIG_ACK);
  1211. #endif
  1212.  
  1213.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
  1214.               TRUE),
  1215.         &st, &gv, TRUE);
  1216.     if (!cv || !CvROOT(cv) &&
  1217.     *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  1218.     
  1219.     if (sig_name[sig][1] == 'H')
  1220.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1221.             &st, &gv, TRUE);
  1222.     else
  1223.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1224.             &st, &gv, TRUE);
  1225.     /* gag */
  1226.     }
  1227.     if (!cv || !CvROOT(cv)) {
  1228.     if (dowarn)
  1229.         warn("SIG%s handler \"%s\" not defined.\n",
  1230.         sig_name[sig], GvENAME(gv) );
  1231.     return;
  1232.     }
  1233.  
  1234.     oldstack = stack;
  1235.     if (stack != signalstack)
  1236.     AvFILL(signalstack) = 0;
  1237.     SWITCHSTACK(stack, signalstack);
  1238.  
  1239.     sv = sv_newmortal();
  1240.     sv_setpv(sv,sig_name[sig]);
  1241.     PUSHMARK(sp);
  1242.     PUSHs(sv);
  1243.     PUTBACK;
  1244.  
  1245.     perl_call_sv((SV*)cv, G_DISCARD);
  1246.  
  1247.     SWITCHSTACK(signalstack, oldstack);
  1248.  
  1249.     return;
  1250. }
  1251.